#!/usr/bin/perl

# A business logic handler for ATNF telescope operations.
# Copyright 2012 Jamie Stevens.

# Licensed under GPL v3.

use Safe;
use MonicaPoint;
use strict;

# This handler runs as a daemon on the web server and processes a
# set of conditions to produce a set of business logic points.
# It can be queried by a web-server script to add new conditions or
# retrieve the current states of any number of points. It can also
# be told to save a particular value into a business point.

# Our global state hash.
my %state;

# The list of all the condition functions to evaluate.
my %evaluators;

# Do some testing.
$evaluators{'narrabriWindSpeed'} = {
    points => [ 'site.environment.weather.WindSpeed',
		'site.environment.weather.WindAvg10s' ],
    server => [ 'monhost-nar.atnf.csiro.au',
		'monhost-nar.atnf.csiro.au' ],
    outputaction => 'publish'
};
$evaluators{'narrabriWindBad'} = {
    points => [ 'site.environment.weather.WindSpeed',
		'site.environment.weather.WindAvg10s' ],
    server => [ 'monhost-nar.atnf.csiro.au',
		'monhost-nar.atnf.csiro.au' ],
    inputaction => [ 'value', 'value' ],
    outputaction => 'compareOR',
    comparevalues => [ 4, 4 ],
    comparison => [ 'gt', 'gt' ]
};

# Initialise the evaluators.
my $process;
foreach $process (keys %evaluators) {
    &initEvaluator($evaluators{$process});
}

# Go into our infinite loop.
while (1) {
    # Go through each evaluator.
    foreach $process (keys %evaluators) {
	# Get the latest values.
	&latestEvaluator($evaluators{$process});
	# Do what the evaluator wants.
	$state{$process} = &doEvaluator($evaluators{$process});
	# Debug!
	print $state{$process}."\n";
    }

    # Wait for a while.
    sleep 5;
}

# A bunch of simple comparitors.
my %comparitors = (
    'gt' => sub { ($_[0] > $_[1]) ? 1 : 0; },
    'lt' => sub { ($_[0] < $_[1]) ? 1 : 0; },
    'ge' => sub { ($_[0] >= $_[1]) ? 1 : 0; },
    'le' => sub { ($_[0] <= $_[1]) ? 1 : 0; },
    );

# This routine handles all the actions for an evaluator.
sub doEvaluator {
    my $teval = shift;

    # Split depending on the action.
    my $rval;
    if ($teval->{outputaction} eq 'publish') {
	# Make a JSON string with all the points. We don't
	# put the wrapping { } because we'll leave that to the
	# task that actually communicates with the web client.
	$rval = "points: [";
	for (my $i = 0; $i <= $#{$teval->{pointrefs}}; $i++) {
	    if ($i > 0) {
		$rval .= ",";
	    }
	    $rval .= "{".${$teval->{pointrefs}}[$i]->publishJSON().
		"}";
	}
	$rval .= " ]";
    } elsif ($teval->{outputaction} =~ /^compare/) {
	# Get the results of all the input actions.
	my @inpvals = &executeInputActions($teval);
	# Make our booleans.
	if ($teval->{outputaction} eq 'compareOR') {
	    $rval = 0;
	} elsif ($teval->{outputaction} eq 'compareAND') {
	    $rval = 1;
	}
	for (my $i = 0; $i <= $#inpvals; $i++) {
	    my $boolval = 
		$comparitors{$teval->{comparison}->[$i]}->(
		    $inpvals[$i],
		    $teval->{comparevalues}->[$i]);
	    if ($teval->{outputaction} eq 'compareOR') {
		$rval = $rval || $boolval;
	    } elsif ($teval->{outputaction} eq 'compareAND') {
		$rval = $rval && $boolval;
	    }
	}
	
    }

    return $rval;
}

# Execute a set of input actions for an evaluator.
sub executeInputActions {
    my $teval = shift;

    my @pointres;
    for (my $i = 0; $i <= $#{$teval->{pointrefs}}; $i++) {
	$pointres[$i] = &doInput($teval->{pointrefs}->[$i],
				 $teval->{inputaction}->[$i]);
    }

    return @pointres;
}

# Actually perform the input action.
sub doInput {
    my $pointref = shift;
    my $action = shift;

    if ($action eq 'value') {
	# Get the latest value for the point.
	my $rval = $pointref->value();
	return $rval->val;
    }
}

# This routine gets all the latest values for an evaluator.
sub latestEvaluator {
    my $teval = shift;

    for (my $i = 0; $i <= $#{$teval->{pointrefs}}; $i++) {
	${$teval->{pointrefs}}[$i]->get_value();
    }
}

# We use this routine to initialise a single evaluator.
sub initEvaluator {
    my $teval = shift;

    $teval->{pointrefs} = [];
    for (my $i = 0; $i <= $#{$teval->{points}}; $i++) {
	${$teval->{pointrefs}}[$i] =
	    MonicaPoint->new(${$teval->{points}}[$i],
			     ${$teval->{server}}[$i]);
    }

    return;
}

# This routine is a very safe eval routine to use for any
# user-specified functions we are given. It allows only
# non-dangerous operators, and throws an error otherwise.
# From www.daniweb.com/software-development/perl/code/216821
sub safeEval {
    my ($expr) = @_;

    # Make a new safe compartment.
    my ($cpt) = new Safe;

    # Allow basic variable IO and traversal.
    $cpt->permit_only(qw(null scalar const padany lineseq leaveeval rv2sv return));
    
    # Allow comparators.
    $cpt->permit(qw(lt i_lt gt i_gt le i_le ge i_ge eq i_eq ne i_ne ncmp i_ncmp slt sgt sle sge seq sne scmp));

    # Allow basic math.
    $cpt->permit(qw(preinc i_preinc predec i_predec postinc i_postinc postdec i_postdec int hex oct abs pow multiply i_multiply divide i_divide modulo i_modulo add i_add subtract i_subtract));
    
    # Allow binary math.
    $cpt->permit(qw(left_shift right_shift bit_and bit_xor bit_or negate i_negate not complement));

    # Allow regular expressions.
    $cpt->permit(qw(match split qr));
    
    # Allow conditionals.
    $cpt->permit(qw(cond_expr flip flop andassign orassign and or xor));
    
    # Allow advanced math.
    $cpt->permit(qw(atan2 sin cos exp log sqrt rand srand));

    # Do the safe evaluation.
    my ($ret) = $cpt->reval($expr);

    if ($@) {
	# An error means the expression wanted to do something forbidden.
	return $@;
    } else {
	return $ret;
    }
}

